;; This file is part of scheme-GNUnet.
;; Copyright (C) 2021 Maxime Devos
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL3.0-or-later

;; C source: src/util/client.c (not completely ported).
;; The Scheme implementation is rather different from the C implementation
;; though.
;;
;; This module allows communication between GNUnet services using stream
;; sockets.

(define-library (gnu gnunet mq-impl stream)
  (export write-envelope! handle-input! handle-output!)
  (import (only (gnu gnunet mq)
		make-one-by-one-sender inject-message! inject-error!)
	  (only (gnu gnunet utils bv-slice)
		slice-bv slice-offset slice-length
		slice-readable? bv-slice/read-write
		slice/read-only)
	  (only (gnu gnunet mq envelope)
		attempt-irrevocable-sent!)
	  (only (gnu gnunet utils tokeniser)
		make-tokeniser add-from-port!)
	  (only (gnu gnunet utils hat-let)
		let^)
	  (only (rnrs base)
		begin define let values quote
		assert)
	  (only (guile)
		error)
	  (only (rnrs io ports)
		put-bytevector)
	  (srfi srfi-26))
  (begin
    (define (write-envelope! output envelope)
      "Write the envelope @var{envelope} to the output port @var{output},
unless it is cancelled.  @var{envelope} may not be already sent.  This
can block and raise I/O errors, depending on the port @var{output} and
(in Guile) the current write waiter.  As such, the caller might need to
parameterise the current write waiter and install exception handlers."
      (attempt-irrevocable-sent!
       envelope
       ((go message priority)
	(assert (slice-readable? message))
	(put-bytevector output (slice-bv message)
			(slice-offset message) (slice-length message))
	(values))
       ((cancelled) (values))
       ((already-sent) (error "tried to send an envelope twice"))))

    ;; TODO: maybe note that this procedure blocks?
    (define (handle-input! mq input)
      "Keep reading message from the input port @var{input}.

Feed each read message in-order to @var{mq} with @code{inject-message!}.
This procedure might inject errors by its own as usual (e.g. when
no appropriate message handler exists).

If a message with an overly small message size it its header
is encountered, inject the error @code{input:overly-small type size}
into @var{mq}, where @var{type} is the message type as an integer
(or @code{#f} if it could not be determined) and @var{size} is the
message size in the header.

When the first [1] end-of-file has been reached, inject the error
@code{input:regular-end-of-file} into @var{mq}.  If the end-of-file
happened while inside a (partial) message, inject
@code{input:premature-end-of-file} instead.  In case of an I/O error,
TODO.

In these exceptional cases, the call to this procedure also returns
after injecting the error. TODO closing message queues."
      (let^ ((! tok (make-tokeniser))
	     (! (handle/message bv offset length)
		(inject-message!
		 mq
		 ;; TODO: this allocates memory
		 (slice/read-only
		  (bv-slice/read-write bv offset length))))
	     (! (return/overly-small type size)
		(inject-error! mq 'input:overly-small type size)
		(values))
	     (! (return/premature-eof)
		(inject-error! mq 'input:premature-end-of-file)
		(values))
	     (! (return/done-eof)
		(inject-error! mq 'input:regular-end-of-file)
		(values)))
	    (add-from-port! tok input handle/message return/overly-small
			    return/done-eof return/premature-eof)))

    (define (handle-output! mq output wait!)
      "Keep sending message envelopes over the output port @var{output}.

The messages to send are taken in-order from the message queue @var{mq}.
In case of an I/O error, ???.  When the message queue is (temporarily)
empty, the thunk @var{wait!} is called.  It should return when messages
have been added to the queue.

When using guile-fibers, @var{wait!} can be implemented with
@code{await-trigger!} and by calling @code{trigger-condition!}
from the ‘message sender’ of @var{mq}.

TODO: closing, destroying @var{mq}, @var{output}."
      (define (one-by-one-proc ev)
	(write-envelope! output ev))
      (define send-round
	(cute (make-one-by-one-sender one-by-one-proc)
	      mq))
      (let loop ()
	;; Doing 'wait!' or 'send-round' the other way around
	;; should be acceptable as well.
	(send-round)
	(wait!)
	(loop)))

    ;; TODO connecting to TCP ports, Unix domain sockets ...?
    ))
